Carousel Volume 2 #1/carousel.iso/mactosh/lang/p_image1.sit/LSP Source/Graphics.p

Text File | 1989-07-29 | 28.3 KB | 1,198 lines

unit Graphics;

{Graphics routines used by Image program}

interface

    uses
        QuickDraw, ToolIntf, PickerIntf, OSIntf, PrintTraps, globals, Utilities;

    procedure DoPlot (event: EventRecord; start, finish: point);
    procedure DrawPlot;
    procedure ShowResults;
    procedure SetupPlot (var data: LineType; start: point);
    procedure MakePlotWindow (PlotLeft, PlotTop, PlotWidth, PlotHeight: integer);
    procedure DrawObject (obj: ObjectType; p1, p2: point);
    procedure DrawLUT;
    procedure DrawTools;
    procedure DrawHistogram;
    procedure DrawGrayMap;
    procedure ResetGrayMap;
    procedure DoMouseDownInGrayMap;

implementation


    procedure DrawNum (x, y: integer; value: LongInt);
        var
            str: str255;
    begin
        MoveTo(x, y);
        if value < 10 then
            DrawString('0');
        if value < 100 then
            DrawString('0');
        NumToString(value, str);
        DrawString(str);
    end;


    procedure LabelProfilePlot;
        var
            str: str255;
            min, max: extended;
    begin
        if InvertPlots then begin
                min := PlotMax;
                max := PlotMin
            end
        else begin
                min := PlotMin;
                max := PlotMax
            end;
        if info^.Calibrated then begin
                MoveTo(2, PlotHeight - PlotBottomMargin);
                DrawReal(Min, 1, 2);
                MoveTo(2, PlotTopMargin + 8);
                DrawReal(Max, 1, 2);
            end
        else begin
                DrawNum(2, PlotHeight - PlotBottomMargin, trunc(Min));
                DrawNum(2, PlotTopMargin + 8, trunc(Max));
            end;
        MoveTo(PlotLeftMargin + 15, PlotHeight - PlotBottomMargin + 12);
        DrawString('N=');
        NumToString(PlotCount, str);
        DrawString(str);
        DrawString('     Mean=');
        RealToString(PlotMean, 3, 2, str);
        DrawString(str);
        if PlotAvg > 1 then begin
                DrawString('    Width=');
                NumToString(PlotAvg, str);
                DrawString(str);
            end;
        DrawString('    ');
        if info^.Calibrated then begin
                DrawString('Calibrated(');
                DrawString(info^.UnitOfMeasure);
                DrawString(')');
            end
        else
            DrawString('Uncalibrated');
    end;


    procedure LabelCalibrationPlot;
        var
            pbottom, hloc, vloc, i: integer;
            letter: packed array[1..6] of char;
    begin
        pbottom := PlotHeight - PLotBottomMargin;
        MoveTo(2, PlotTopMargin + 4);
        DrawReal(MaxValue, 4, 2);
        MoveTo(2, pbottom);
        DrawReal(MinValue, 4, 2);
        MoveTo(PlotLeftMargin - 3, pbottom + 10);
        DrawString('0');
        MoveTo(PlotWidth - PlotRightMargin - 14, pbottom + 10);
        DrawString('255');
        MoveTo(PlotLeftMargin + 15, PlotTopMargin + 15);
        TextSize(12);
        case info^.fit of
            StrightLine:
                DrawString('y=a+bx');
            Poly2:
                DrawString('y=a+bx+cx^2');
            Poly3:
                DrawString('y=a+bx+cx^2+dx^3');
            Poly4:
                DrawString('y=a+bx+cx^2+dx^3+ex^4');
            Poly5:
                DrawString('y=a+bx+cx^2+dx^3+ex^4+fx^5');
            ExpoFit:
                DrawString('y=aexp(bx)');
            PowerFit:
                DrawString('y=ax^b');
            LogFit:
                DrawString('y=aln(bx)');
        end;
        hloc := PlotWidth - PlotRightMargin + 5;
        vloc := PlotTopMargin + 25;
        letter := 'abcdef';
        MoveTo(hloc, vloc);
        with info^ do
            for i := 1 to nCoefficients do begin
                    MoveTo(hloc, vloc);
                    TextSize(12);
                    DrawString(letter[i]);
                    DrawString('=');
                    TextSize(9);
                    DrawReal(Coefficient[i], 1, 8);
                    vloc := vloc + 15;
                end;
        vloc := vloc + 25;
        MoveTo(hloc, vloc);
        DrawString('S.D.=');
        DrawReal(FitSD, 1, 4);
        vloc := vloc + 15;
        MoveTo(hloc, vloc);
        DrawString('R^2=');
        DrawReal(FitGoodness, 1, 4);
    end;


    procedure DrawPlot;
        var
            tPort: GrafPtr;
            fRect: rect;
    begin
        if not Printing then begin
                GetPort(tPort);
                SetPort(PlotWindow);
                EraseRect(PlotWindow^.portRect);
            end;
        SetRect(fRect, PlotLeftMargin, PlotTopMargin, PlotWidth - PlotRightMargin, PlotHeight - PlotBottomMargin);
        PenNormal;
        FrameRect(fRect);
        DrawPicture(PlotPICT, fRect);
        TextFont(ApplFont);
        TextSize(9);
        if WindowPeek(PlotWindow)^.WindowKind = ProfilePlotKind then begin
                if DrawPlotLabels then
                    LabelProfilePlot
            end
        else
            LabelCalibrationPlot;
        if not printing then begin
                if not Copying then
                    DrawMyGrowIcon(PlotWindow);
                SetPort(tPort);
            end;
    end;


    procedure MakePlotWindow; {(PlotLeft, PlotTop, PlotWidth, PlotHeight: integer)}
        var
            PLotRect, pwrect, dwrect, srect: rect;
            overlapping: boolean;
    begin
        if PlotWindow = nil then begin
                SetRect(PlotRect, PlotLeft, PlotTop, PlotLeft + PlotWidth, PlotTop + PlotHeight);
                PlotWindow := NewWindow(nil, PlotRect, 'Plot', true, DocumentProc, nil, true, 0);
                SetMenuItem(GetMHandle(WindowsMenu), 8, true);
            end
        else begin
                GetWindowRect(PlotWindow, pwrect);
                GetWindowRect(info^.wptr, dwrect);
                overlapping := SectRect(pwrect, dwrect, srect);
                if overlapping then
                    MoveWindow(PlotWindow, PlotLeft, PlotTop, false);
                SizeWindow(PlotWindow, PlotWidth, PlotHeight, false);
            end;
    end;


    procedure SetupPlot; {(var data: LineType; start: point)}
        var
            fRect: rect;
            tPort: GrafPtr;
            i, width, y, fmax: integer;
            ClipRegion, SaveClipRegion: RgnHandle;
            pt: point;
            temp, sum, vscale: extended;
            AutoScale: boolean;
            RealData: array[0..MaxPixelsPerLine] of extended;
            index: UnsignedByte;
    begin
        if info^.calibrated then
            PlotLeftMargin := 35
        else
            PlotLeftMargin := 25;
        PlotTopMargin := 10;
        PlotBottomMargin := 20;
        PlotRightMargin := 10;
        for i := 0 to PlotCount - 1 do
            RealData[i] := value[data[i]];
        if InvertPlots then
            for i := 0 to PlotCount - 1 do
                RealData[i] := MaxValue - RealData[i];
        if FixedSizePlot then begin
                width := ProfilePlotWidth;
                PlotWidth := width;
                PlotHeight := ProfilePlotHeight
            end
        else begin
                Width := PlotCount * trunc(Info^.magnification + 0.5);
                if Width < 50 then
                    Width := 100;
                PlotHeight := Width div 2;
                if PlotWidth > 300 then
                    PlotHeight := width div 3;
                if PlotWidth > 400 then
                    PlotHeight := width div 4;
            end;
        PlotWidth := Width + PlotLeftMargin + PlotRightMargin;
        PlotHeight := PlotHeight + PlotTopMargin + PlotBottomMargin;
        pt.h := start.h;
        pt.v := start.v + 40;
        LocalToGlobal(pt);
        PlotLeft := pt.h - PlotLeftMargin;
        PlotTop := pt.v;
        if PlotTop > (ScreenHeight - PlotHeight) then
            PlotTop := PlotTop - PlotHeight - 60;
        if PlotTop < 60 then
            PlotTop := 60;
        MakePlotWindow(PlotLeft, PlotTop, PlotWidth, PlotHeight);
        WindowPeek(PlotWindow)^.WindowKind := ProfilePlotKind;
        PlotMin := MinValue;
        PlotMax := MaxValue;
        sum := 0.0;
        for i := 0 to PlotCount - 1 do begin
                temp := RealData[i];
                sum := sum + temp;
                if AutoscalePlots then begin
                        if temp < PlotMin then
                            PlotMin := temp;
                        if temp > PlotMax then
                            PlotMax := temp;
                    end;
            end;
        if PlotCount > 0 then
            PlotMean := sum / PlotCount
        else
            PlotMean := 0.0;
        if not AutoscalePlots then begin
                PlotMin := ProfilePlotMin;
                PlotMax := ProfilePlotMax;
            end;
        fmax := PlotCount - 1;
        if (PlotMax - PlotMin) <> 0 then
            vscale := fmax / (PlotMax - PlotMin)
        else
            vscale := 1.0;
        SetRect(fRect, 0, 0, fmax, fmax);
        GetPort(tPort);
        SetPort(PlotWindow);
        SaveClipRegion := PlotWindow^.ClipRgn;
        ClipRegion := NewRgn;
        OpenRgn;
        FrameRect(fRect);
        CloseRgn(ClipRegion);
        PlotWindow^.ClipRgn := ClipRegion;
        PlotPICT := OpenPicture(fRect);
        PenNormal;
        if LinePlot then begin
                MoveTo(0, round(vscale * (PlotMax - RealData[0])));
                for i := 1 to PlotCount - 1 do
                    LineTo(i, round(vscale * (PlotMax - RealData[i])))
            end
        else
            for i := 1 to PlotCount - 1 do begin
                    y := round(vscale * (PlotMax - RealData[i]));
                    MoveTo(i, y);
                    LineTo(i, y)
                end;
        ClosePicture;
        PlotWindow^.ClipRgn := SaveClipRegion;
        DisposeRgn(ClipRegion);
        InvalRect(PlotWindow^.PortRect);
        SetPort(tPort);
        SelectWindow(PlotWindow);
    end;


    procedure DoPlot;{ (event: EventRecord; start, finish: point)}
        var
            i, range, width, value: integer;
            p1, p2, pt: point;
    begin
        with Info^.wrect do begin
                if finish.h >= right then
                    finish.h := right - 1;
                if finish.v >= bottom then
                    finish.v := bottom - 1;
            end;
        if finish.h < start.h then begin {Swap ends}
                pt := start;
                start := finish;
                finish := pt;
            end;
        p1 := start;
        p2 := finish;
        ScreenToOffscreen(p1);
        ScreenToOffscreen(p2);
        GetDiagLine(p1, p2, PlotCount, PlotData);
        PlotAvg := LineWidth;
        SetupPlot(PlotData, start);
    end;


    procedure FilterHistogram (var h: HistogramType);
        var
            i: integer;
    begin
        for i := 1 to 254 do
            h[i] := (h[i - 1] + h[i] + h[i + 1]) div 3;
    end;



    procedure ShowResults;
        var
            vloc, hloc, i: integer;
            tPort: GrafPtr;
            trect: rect;
            clength, cx, cy, IntDen, BackgroundLevel: extended;
            MaxCount: LongInt;
            h: HistogramType;

        procedure NewLine;
        begin
            vloc := vloc + 12;
            MoveTo(hloc, vloc);
        end;

    begin
        GetPort(tPort);
        vloc := 35;
        hloc := 4;
        SetPort(ResultsWindow);
        TextFont(ApplFont);
        TextSize(9);
        Setrect(trect, 0, vloc, rwidth, rheight);
        EraseRect(trect);
        with results do begin
                NewLine;
                case CurrentTool of
                    ruler:
                        with info^ do begin
                                DrawBString('Count: ');
                                DrawLong(nLengths);
                                NewLine;
                                DrawBString('Length: ');
                                DrawReal(lengths[nLengths], 1, 2);
                                DrawString(' ');
                                if scale <> 0.0 then
                                    DrawString(Units)
                                else
                                    DrawString('Pixels');
                                NewLine;
                                DrawBString('Total: ');
                                DrawReal(TotalLength, 1, 2);
                            end;
                    PointingTool:
                        begin
                            DrawBString('Count: ');
                            DrawLong(nPoints);
                            NewLine;
                            DrawBString('X: ');
                            DrawReal(x, 1, 2);
                            NewLine;
                            DrawBString('Y: ');
                            DrawReal(y, 1, 2);
                        end;
                    AngleTool:
                        begin
                            DrawBString('Angle: ');
                            DrawReal(angle, 1, 2);
                            DrawString(' degrees');
                            NewLine;
                        end;
                    otherwise
                        with info^ do begin
                                DrawBString('Count: ');
                                DrawLong(nAreas);
                                NewLine;
                                DrawBString('N: ');
                                DrawLong(n);
                                if scale <> 0.0 then begin
                                        NewLine;
                                        DrawBString('Area: ');
                                        DrawReal(n / sqr(scale), 1, 2);
                                        DrawString(' square ');
                                        DrawString(units);
                                    end;
                                NewLine;
                                DrawBString('Mean: ');
                                DrawReal(mean[nAreas], 1, 2);
                                if calibrated then begin
                                        DrawString(' ');
                                        DrawBString(UnitOfMeasure);
                                        DrawString('   (');
                                        DrawLong(results.imean);
                                        DrawString(')');
                                    end;
                                if BinaryPic then begin
                                        NewLine;
                                        DrawBString('Black: ');
                                        DrawLong(histogram[255]);
                                        NewLine;
                                        DrawBString('White: ');
                                        DrawLong(histogram[0]);
                                    end
                                else begin
                                        if (imin = 0) or (imin = 1) or (imax = 255) or (imax = 254) then
                                            DrawBString(' (Possible Saturation)');
                                        NewLine;
                                        DrawBString('Std Dev: ');
                                        DrawReal(SD[nAreas], 1, 4);
                                        NewLine;
                                        DrawBString('Min: ');
                                        DrawReal(min, 1, 2);
                                        NewLine;
                                        DrawBString('Max: ');
                                        DrawReal(max, 1, 2);
                                    end;
                                if xyLocM in Measurements then begin
                                        NewLine;
                                        DrawBString('X,Y: ');
                                        DrawReal(xcenter[nAreas], 6, 2);
                                        DrawString(',');
                                        DrawReal(ycenter[nAreas], 6, 2);
                                    end;
                                if ModeM in Measurements then begin
                                        NewLine;
                                        DrawBString('Mode: ');
                                        DrawReal(mode[nAreas], 1, 2);
                                    end;
                                if IntDenM in measurements then begin
                                        NewLine;
                                        h := histogram;
                                        FilterHistogram(h);
                                        FilterHistogram(h);
                                        FilterHistogram(h);
                                        BackgroundLevel := 0.0;
                                        MaxCount := 0;
                                        for i := 0 to 255 do
                                            if h[i] > MaxCount then begin
                                                    MaxCount := h[i];
                                                    BackgroundLevel := value[i]
                                                end;
                                        IntDen := n * (mean[nAreas] - BackgroundLevel);
                                        DrawBString('Integrated Density: ');
                                        DrawReal(IntDen, 1, 2);
                                        NewLine;
                                        DrawBString('Background Level: ');
                                        DrawReal(BackGroundLevel, 1, 2);
                                    end
                                else
                                    IntDen := 0.0;
                                IntegratedDensity[nAreas] := IntDen;
                                if PerimeterM in measurements then begin
                                        NewLine;
                                        DrawBString('Perimeter Length: ');
                                        DrawReal(plength[nAreas], 1, 2);
                                    end;
                            end;
                end; {case}
            end; {with}
        SetPort(tPort);
        nAreas2 := nAreas;
    end;


    procedure PaintCircle (hloc, vloc: integer);
        var
            r: rect;
    begin
        SetRect(r, hloc, vloc, hloc + LineWidth, vloc + LineWidth);
        PaintOval(r);
    end;


    procedure DrawBrush (start, finish: point);
  {Thanks to Robert Rimmer for suggesting the use of a line generator to implement the brush.}
        var
            deltax, deltay, xinc, yinc, accumulator, i: integer;
            xloc, yloc, offset, j: integer;
    begin
        xloc := start.h;
        yloc := start.v;
        deltax := finish.h - xloc;
        deltay := finish.v - yloc;
        if (deltax = 0) and (deltay = 0) then begin
                PaintCircle(xloc, yloc);
                exit(DrawBrush)
            end;
        if deltax < 0 then begin
                xinc := -1;
                deltax := -deltax
            end
        else
            xinc := 1;
        if deltay < 0 then begin
                yinc := -1;
                deltay := -deltay
            end
        else
            yinc := 1;
        if DeltaX > DeltaY then begin {More horizontal}
                accumulator := deltax div 2;
                i := deltax;
                repeat
                    accumulator := accumulator + deltay;
                    if accumulator >= deltax then begin
                            accumulator := accumulator - deltax;
                            yloc := yloc + yinc
                        end;
                    xloc := xloc + xinc;
                    PaintCircle(xloc, yloc);
                    i := i - 1;
                until i = 0
            end
        else begin          {More vertical}
                accumulator := deltay div 2;
                i := deltay;
                repeat
                    accumulator := accumulator + deltax;
                    if accumulator >= deltay then begin
                            accumulator := accumulator - deltay;
                            xloc := xloc + xinc
                        end;
                    yloc := yloc + yinc;
                    PaintCircle(xloc, yloc);
                    i := i - 1;
                until i = 0
            end;
    end;


    procedure DrawObject;{ (obj: ObjectType; p1, p2: point)}
        var
            MaskRect, r, dstRect, osMaskRect: rect;
            tPort: GrafPtr;
            tmp: integer;
    begin
        GetPort(tPort);
        Pt2Rect(p1, p2, MaskRect);
        with Info^ do begin
                changes := true;
                tmp := trunc(magnification + 0.5) * LineWidth;
                with MaskRect do begin
                        if tmp < 32 then
                            tmp := 32;
                        right := right + tmp;
                        bottom := bottom + tmp;
                        if magnification > 1.0 then begin
                                left := left - tmp;
                                top := top - tmp;
                            end;
                    end;
                ScreenToOffscreen(p1);
                ScreenToOffscreen(p2);
                SetPort(GrafPtr(osPort));
                PenNormal;
                PenSize(LineWidth, LineWidth);
                case obj of
                    lineObj:
                        begin
                            MoveTo(p1.h, p1.v);
                            LineTo(p2.h, p2.v);
                        end;
                    Rectangle:
                        begin
                            Pt2Rect(p1, p2, r);
                            FrameRect(r);
                        end;
                    RoundedRect:
                        begin
                            Pt2Rect(p1, p2, r);
                            FrameRoundRect(r, OvalSize, OvalSize);
                        end;
                    oval:
                        begin
                            Pt2Rect(p1, p2, r);
                            FrameOval(r);
                        end;
                    BrushObj:
                        DrawBrush(p1, p2);
                end;
                SetPort(tPort);
                RectRgn(MaskRgn, MaskRect);
                hlock(handle(osPort^.portPixMap));
                hlock(handle(CGrafPort(ThePort^).PortPixMap));
                CopyBits(BitMapHandle(osPort^.portPixMap)^^, BitMapHandle(CGrafPort(ThePort^).PortPixMap)^^, SrcRect, wrect, SrcCopy, MaskRgn);
                hunlock(handle(osPort^.portPixMap));
                hunlock(handle(CGrafPort(ThePort^).PortPixMap));
            end; {with}
    end;


    procedure DrawLUT;
        var
            tPort: GrafPtr;
            h, v, i: integer;
    begin
        GetPort(tPort);
        SetPort(LUTWindow);
        with ThePort^ do begin
                for v := 0 to 255 do begin
                        fgColor := v;
                        MoveTo(0, v);
                        LineTo(cwidth, v)
                    end;
                for i := 1 to nExtraColors + 2 do begin
                        fgColor := ExtraColorsEntry[i];
                        PaintRect(ExtraColorsRect[i]);
                    end;
                TextFont(ApplFont);
                TextSize(9);
                with ExtraColorsRect[1] do
                    MoveTo(left + 3, bottom - 1);
                fgcolor := BlackC;
                DrawString('white');
                with ExtraColorsRect[2] do
                    MoveTo(left + 4, bottom - 1);
                InvertRect(ExtraColorsRect[2]);
                DrawString('black');
                InvertRect(ExtraColorsRect[2]);
            end;
        SetPort(tPort);
    end;


    procedure GetRGBColors (var ForegroundRGB, BackgroundRGB: RGBColor);
    begin
        ForegroundRGB := info^.cTable[ForegroundColor].rgb;
        if ForegroundColor = 0 then
            ForegroundRGB := WhiteRGB;
        if ForegroundColor = 255 then
            ForegroundRGB := BlackRGB;
        if nExtraColors > 0 then begin
                if (ForegroundColor >= FirstExtraColorsEntry) and (ForegroundColor < (FirstExtraColorsEntry + nExtraColors)) then
                    ForegroundRGB := ExtraColors[ForegroundColor - FirstExtraColorsEntry + 1];
            end;
        BackgroundRGB := info^.cTable[BackgroundColor].rgb;
        if BackgroundColor = 0 then
            BackgroundRGB := WhiteRGB;
        if BackgroundColor = 255 then
            BackgroundRGB := BlackRGB;
        if nExtraColors > 0 then begin
                if (BackgroundColor >= FirstExtraColorsEntry) and (BackgroundColor < (FirstExtraColorsEntry + nExtraColors)) then
                    BackgroundRGB := ExtraColors[BackgroundColor - FirstExtraColorsEntry + 1];
            end;
    end;

    procedure DrawTools;
        var
            tPort: GrafPtr;
            v, n, i: integer;
            str: str255;
            tool: ToolType;
            ForegroundRGB, BackgroundRGB: RGBColor;
    begin
        GetPort(tPort);
        SetPort(ToolWindow);
        TextFont(ToolFont);
        TextSize(12);
        EraseRect(CGrafPort(ToolWindow^).PortPixMap^^.bounds);
        for tool := FirstTool to LastTool do
            with ToolRect[tool] do begin
                    MoveTo(left + ho, top + vo);
                    DrawChar(ToolChar[tool]);
                end;
        InvertRect(ToolRect[CurrentTool]);
{ToolWindow^.fgColor := ForegroundColor;}
        GetRGBColors(ForegroundRGB, BackgroundRGB);
        RGBForeColor(ForegroundRGB);
        with ToolRect[brush] do
            MoveTo(left + ho, top + vo);
        DrawChar(chr(80));
{ToolWindow^.fgColor := BackgroundColor;}
        RGBForeColor(BackgroundRGB);
        with ToolRect[Eraser] do
            MoveTo(left + ho, top + vo);
        DrawChar(chr(102));
{ToolWindow^.fgColor := BlackC;}
        RGBForeColor(BlackRGB);
        for i := 1 to nLineTypes do
            PaintRect(lines[i]);
        MoveTo(0, Lines[LineIndex].top - 9);
        DrawChar(chr(CheckMarkChar));
        SetPort(tPort);
    end;


    procedure DrawHistogram;
        var
            tPort: GrafPtr;
            h, scale, NonZero, hstart, hend: integer;
            v, MaxCount, count: LongInt;
            str: str255;
    begin
        if not printing then begin
                GetPort(tPort);
                SetPort(HistoWindow);
                EraseRect(HistoWindow^.portRect);
            end;
        with results do begin
                MaxCount := histogram[imode];
                if MaxCount > (hheight - 2) then begin
                        scale := trunc(MaxCount / (hheight - 2));
                        scale := scale + 1
                    end
                else
                    scale := 1;
                NonZero := 0;
                if Thresholding then begin
                        hstart := ThresholdStart;
                        hend := ThresholdEnd
                    end
                else begin
                        hstart := 0;
                        hend := 255
                    end;
                for h := hstart to hend do begin
                        MoveTo(h, hheight);
                        count := histogram[h];
                        v := hheight - (count div scale);
                        if v < 0 then
                            v := 0;
                        LineTo(h, v);
                        if count > 0 then
                            NonZero := NonZero + 1;
                    end;
            end;
        if not Printing then
            SetPort(tPort);
        LoadLUT(info^.cTable);
    end;


    procedure UpdateGrayMap;
        const
            gmRectArea = 4096.0; {64x64}
            max = 4177920;
        var
            tPort: GrafPtr;
            r: rect;
            x, y, i, h1, h2, h3, v1, v2, v3, dx, dy: integer;
            xcenter, ycenter, brightness, islope, thumb: integer;
            table: LookupTable;
            hrect: rect;
            slope: extended;
            area, value, sum: LongInt;
    begin
        GetPort(tPort);
        SetPort(GrayMapWindow);
        PenNormal;
        EraseRect(GrayMapRect2);
        FrameRect(GrayMapRect);
        with info^ do
            if LutMode = CustomGrayscale then begin
                    GetLookupTable(table);
                    for i := 0 to 63 do begin
                            x := gmRectLeft + 63 - i;
                            y := gmRectTop + table[i * 4] div 4;
                            MoveTo(x, y);
                            LineTo(x, y);
                        end
                end
            else begin
                    h1 := gmRectLeft + p1x div 4;
                    v1 := gmRectBottom - 1 - (p1y div 4);
                    h2 := gmRectLeft + p2x div 4;
                    v2 := gmRectBottom - 1 - (p2y div 4);
                    MoveTo(gmRectLeft, gmRectBottom - 1);
                    LineTo(h1, v1);
                    LineTo(h2, v2);
                    LineTo(gmRectRight - 1, gmRectTop);
                    SetRect(hrect, h1 - 1, v1 - 1, h1 + 2, v1 + 2);
                    PaintRect(hrect); {First handle}
                    SetRect(hrect, h2 - 1, v2 - 1, h2 + 2, v2 + 2);
                    PaintRect(hrect); {Last handle}
                    dx := p2x - p1x;
                    dy := p2y - p1y;
                    xcenter := p1x + dx div 2;
                    ycenter := p1y + dy div 2;
                    h3 := gmRectLeft + xcenter div 4;
                    v3 := gmRectBottom - 1 - (ycenter div 4);
                    SetRect(hrect, h3 - 1, v3 - 1, h3 + 2, v3 + 2);
                    PaintRect(hrect); {Center handle}
                    thumb := gmSlideHeight - 2;
                    i := 0;
                    sum := 0;
                    repeat
                        value := ctable[i].rgb.red;
                        value := band(value, 65535);
                        sum := sum + value;
                        i := i + 4;
                    until i > 255;
                    brightness := trunc((sum / max) * (gmSlideWidth - thumb - 2.0));
                    gmSlide1Loc := brightness;
                    with gmSlide1 do
                        SetRect(hrect, left + brightness + 1, top + 1, left + brightness + thumb + 1, top + thumb + 1);
                    EraseRect(gmSlide1i);
                    PaintRect(hrect);  {Thumb for brightness control}
                    if dx <> 0 then
                        slope := dy / dx
                    else
                        slope := 1000.0;
                    if slope > 1.0 then begin
                            if dy <> 0 then
                                slope := 2.0 - dx / dy
                            else
                                slope := 2.0;
                        end;
                    islope := trunc(slope * 0.5 * (gmSlideWidth - thumb - 2.0));
                    with gmSlide2 do
                        SetRect(hrect, left + islope + 1, top + 1, left + islope + thumb + 1, top + thumb + 1);
                    EraseRect(gmSlide2i);
                    PaintRect(hrect);  {Thumb for contrast control}
                end;
        SetPort(tPort);
    end;


    procedure DrawGrayMap;
        var
            tPort: GrafPtr;
            x, y, i: integer;
            table: LookupTable;
    begin
        GetPort(tPort);
        SetPort(GrayMapWindow);
        PenNormal;
        TextFont(ApplFont);
        TextSize(9);
        with gmSlide1 do
            MoveTo(left - 6, bottom);
        DrawChar('B');
        with gmSlide2 do
            MoveTo(left - 6, bottom);
        DrawChar('C');
        FrameRect(gmSlide1);
        FrameRect(gmSlide2);
        FrameRect(gmIcon1);
        FrameRect(gmIcon2);
        with gmIcon1 do begin
                MoveTo(left, top + 10);
                LineTo(left + 5, top + 10);
                LineTo(left + 12, top + 3);
                LineTo(left + gmIconWidth - 1, top + 3);
            end;
        with gmIcon2 do begin
                MoveTo(left, top + 10);
                LineTo(left + gmIconWidth div 2, top + 10);
                LineTo(left + gmIconWidth div 2, top + 3);
                LineTo(left + gmIconWidth - 1, top + 3);
            end;
        UpdateGrayMap;
        GrayMapReady := true;
        SetPort(tPort);
    end;


    procedure ResetGrayMap;
    begin
        with info^ do begin
                StopThresholding;
                p1x := 0;
                p1y := 0;
                p2x := 255;
                p2y := 255;
                DeltaX := 256;
                DeltaY := 256;
                SetGrayScaleLUT;
                LUTMode := Grayscale;
                if GrayMapReady then
                    UpdateGrayMap;
                IdentityFunction := true;
            end;
    end;


    procedure FindEndPoints (x, y: integer);
        var
            xintercept: integer;
    begin
        with info^ do begin
                if DeltaX = 0 then begin
                        p1x := x;
                        p1y := 0;
                        p2x := x;
                        p2y := 255;
                        exit(FindEndPoints);
                    end;
                if DeltaY = 0 then begin
                        p1x := 0;
                        p1y := y;
                        p2x := 255;
                        p2y := y;
                        exit(FindEndPoints);
                    end;
                p1x := x - y * LongInt(DeltaX) div DeltaY;
                xIntercept := p1x;
                p1y := 0;
                if p1x < 0 then begin
                        p1y := -(LongInt(DeltaY) * p1x) div DeltaX;
                        p1x := 0;
                    end;
                p2y := 255;
                p2x := 255 * LongInt(DeltaX) div DeltaY;
                if xIntercept < 0 then
                    p2x := p2x + xIntercept
                else
                    p2x := p2x + p1x;
                if p2x > 255 then begin
                        p2y := 255 - (p2x - 255) * LongInt(DeltaY) div DeltaX;
                        p2x := 255;
                    end;
                if p2x < 0 then
                    p2x := 0;
            end; {with}
    end;


    procedure ChangeBrightness;
        var
            loc, oldloc, max, HalfMax, thumb, xcenter, ycenter, delta: integer;
            hrect: rect;

        function FindLoc: integer;
            var
                p: point;
                loc: integer;
        begin
            GetMouse(p);
            loc := p.h - gmSlide1.left - 2;
            if loc < 0 then
                loc := 0;
            if loc > max + 5 then
                loc := max + 5;
            FindLoc := loc;
        end;

    begin
        with info^ do begin
                thumb := gmSlideHeight - 2;
                max := gmSlideWidth - thumb - 2;
                HalfMax := max div 2;
                OldLoc := FindLoc;
                repeat
                    xcenter := p1x + (p2x - p1x) div 2;
                    ycenter := p1y + (p2y - p1y) div 2;
                    loc := FindLoc;
                    delta := gmSlide1Loc + 1 - loc;
                    if deltay <> 0 then begin
                            xcenter := xcenter + delta;
                            if xcenter < 0 then
                                xcenter := 0;
                            if xcenter > 255 then
                                xcenter := 255;
                        end;
                    if deltax <> 0 then begin
                            ycenter := ycenter - delta;
                            if ycenter < 0 then
                                ycenter := 0;
                            if ycenter > 255 then
                                ycenter := 255;
                        end;
                    FindEndPoints(xcenter, ycenter);
                    UpdateGrayMap;
                    gmFixedSlope := true;
                    SetGrayScaleLUT;
                    gmFixedSlope := false;
                    OldLoc := loc;
                until not button;
                IdentityFunction := false;
            end; {with}
    end;


    procedure ChangeContrast;
        var
            p: point;
            loc, max, HalfMax, thumb, xcenter, ycenter: integer;
            hrect: rect;
            slope: extended;
    begin
        with info^ do begin
                thumb := gmSlideHeight - 2;
                max := gmSlideWidth - thumb - 2;
                HalfMax := max div 2;
                xcenter := p1x + deltax div 2;
                ycenter := p1y + deltay div 2;
                repeat
                    GetMouse(p);
                    loc := p.h - gmSlide2.left - 2;
                    if loc < 0 then
                        loc := 0;
                    if loc > max then
                        loc := max;
                    if loc <= HalfMax then
                        slope := loc / HalfMax
                    else if loc < max then
                        slope := HalfMax / (max - loc)
                    else
                        slope := 1000.0;
                    if slope <= 1.0 then begin
                            deltax := 255;
                            deltay := round(slope * deltax);
                        end
                    else begin
                            deltay := 255;
                            deltax := round(deltay / slope);
                        end;
                    FindEndPoints(xcenter, ycenter);
                    UpdateGrayMap;
                    SetGrayScaleLUT;
                until not button;
                IdentityFunction := false;
            end; {with}
    end;


    procedure ConvertMouseToXY (p: point; var x, y: integer);
    begin
        x := (p.h - gmRectLeft) * 4;
        if x < 0 then
            x := 0;
        if x > 255 then
            x := 255;
        y := (gmRectBottom - p.v) * 4;
        if y < 0 then
            y := 0;
        if y > 255 then
            y := 255;
    end;

    procedure DoMouseDownInGrayMap;
        var
            r: rect;
            tPort: GrafPtr;
            x, y, p1Dist, p2Dist, x1, y1: integer;
            mode: (StartPoint, EndPoint, Brightness);
            p: point;
            pressed: boolean;

        procedure DoFixup;
        begin
            with info^ do
                if ((p1x = 0) and (p2x = 0)) or ((p1x = 255) and (p2x = 255)) then begin
                        p1y := 0;
                        p2y := 255;
                    end;
        end;

    begin
        StopThresholding;
        ValuesMode := xyValues;
        DrawLabels;
        if info^.LUTMode = CustomGrayscale then
            ResetGrayMap;
        GetPort(tPort);
        SetPort(GrayMapWindow);
        GetMouse(p);
        if PtInRect(p, gmIcon1) then begin
                InvertRect(gmIcon1);
                pressed := true;
                while Button and pressed do begin
                        GetMouse(p);
                        if not PtInRect(p, gmIcon1) then begin
                                InvertRect(gmIcon1);
                                pressed := false;
                            end;
                    end;
                repeat
                until not button;
                if pressed then begin
                        InvertRect(gmIcon1);
                        ResetGrayMap;
                        SetPort(tPort);
                        exit(DoMouseDownInGrayMap)
                    end;
            end;
        if PtInRect(p, gmIcon2) then begin
                InvertRect(gmIcon2);
                pressed := true;
                while Button and pressed do begin
                        GetMouse(p);
                        if not PtInRect(p, gmIcon2) then begin
                                InvertRect(gmIcon2);
                                pressed := false;
                            end;
                    end;
                repeat
                until not button;
                if pressed then begin
                        InvertRect(gmIcon2);
                        with info^ do begin
                                DeltaX := 1;
                                DeltaY := 255;
                                p1x := 128;
                                p1y := 0;
                                p2x := 128;
                                p2y := 255;
                                SetGrayScaleLUT;
                                UpdateGrayMap;
                            end;
                        SetPort(tPort);
                        exit(DoMouseDownInGrayMap)
                    end;
            end;
        if PtInRect(p, gmSlide1) then
            ChangeBrightness;
        if PtInRect(p, gmSlide2) then
            ChangeContrast;
        if p.v > (gmRectBottom + 4) then begin
                SetPort(tPort);
                exit(DoMouseDownInGrayMap);
            end;
        GetMouse(p);
        ConvertMouseToXY(p, x, y);
        if (x <= 24) or (y <= 32) then
            mode := StartPoint
        else if (x >= 224) or (y >= 232) then
            mode := EndPoint
        else
            mode := brightness;
        repeat
            with info^ do
                case mode of
                    StartPoint:
                        begin
                            if x > y then
                                y := 0
                            else
                                x := 0;
                            p1x := x;
                            if p1x > p2x then
                                p2x := p1x;
                            p1y := y;
                            if p1y > p2y then
                                p2y := p1y;
                            DoFixUp;
                            Show2Values(p1x, p1y);
                        end;
                    EndPoint:
                        begin
                            if x > y then
                                x := 255
                            else
                                y := 255;
                            p2x := x;
                            if p2x < p1x then
                                p1x := p2x;
                            p2y := y;
                            if p2y < p1y then
                                p1y := p2y;
                            DoFixUp;
                            Show2Values(p2x, p2y);
                        end;
                    Brightness:
                        FindEndPoints(x, y);
                end; {case}
            UpdateGrayMap;
            gmFixedSlope := mode = brightness;
            SetGrayScaleLUT;
            gmFixedSlope := false;
            GetMouse(p);
            ConvertMouseToXY(p, x, y);
        until not Button;
        SetPort(tPort);
        IdentityFunction := false;
    end;

end.